PC Plus SuperCD (UK) 1997 February/PC Plus Super CD (Issue 124) (PCP124-2-97) (February 1997).iso/handson/delphi/outline3/outl3.pas

Pascal/Delphi Source File | 1996-10-14 | 9.9 KB | 302 lines

unit Outl3;
{ PC PLUS sample Outliner program.
Author: Huw Collingbourne

Demonstrates how to use Delphi's outline object to create a collapsible
outliner. Lets you add and delete items and save/load outlines to/from disk.

Be aware that Delphi 1's outline component is a bit buggy. I've tried
to work around the main problems (particularly the ChangeByLevel method).
As far as I can tell, Delphi 2's outline component works OK.

Features added in this version:
1) When an item is clicked, its text appears in the edit box.
2) A change button lets you change an item's text to the contents of edit box.
3) When an outline is loaded, it is shown fully expanded.
4) There are buttons to indent and outdent items.
5) You can re-order items by dragging and dropping them.

Ideas for further improvements:
* Pop up a Yes/No message box to let the user back out of a delete operation
  when child items exist beneath the selected item.
* Add extra buttons to do a FullExpand or FullCollapse of the outline.

Note: This is program is purely for demonstration purposes.
There is a minimum of error checking and error recovery. It is
not guaranteed to function flawlessly!!!
}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, Outline, ExtCtrls, StdCtrls, Menus;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Outline1: TOutline;
    ItemTextEd: TEdit;
    AddItemBtn: TButton;
    DelBtn: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    OpenMenuItem: TMenuItem;
    NewMenuItem: TMenuItem;
    SaveMenuItem: TMenuItem;
    SaveAsMenuItem: TMenuItem;
    ExitMenuItem: TMenuItem;
    ChangeBtn: TButton;
    OutBtn: TButton;
    InBtn: TButton;
    procedure AddItemBtnClick(Sender: TObject);
    procedure DelBtnClick(Sender: TObject);
    procedure Outline1Click(Sender: TObject);
    procedure ExitMenuItemClick(Sender: TObject);
    procedure NewMenuItemClick(Sender: TObject);
    procedure SaveMenuItemClick(Sender: TObject);
    procedure SaveAsMenuItemClick(Sender: TObject);
    procedure OpenMenuItemClick(Sender: TObject);
    procedure ChangeBtnClick(Sender: TObject);
    procedure OutBtnClick(Sender: TObject);
    procedure InBtnClick(Sender: TObject);
    procedure Outline1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure Outline1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure Outline1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Outline1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DragSourceItem :Integer; { save the row number of source drag&drop item }

implementation

{$R *.DFM}

function ConfirmFileSave(FileName : string) : boolean;
begin
    if MessageDlg(FileName + ' already exists. Save anyway?',
                        mtConfirmation, mbYesNoCancel, 0)
                        = mrYes then
      ConfirmFileSave := true
    else
      ConfirmFileSave := false;
end;

procedure TForm1.AddItemBtnClick(Sender: TObject);
{ Adds text from ItemTextEd text box to the outline as a 'child' item -
  that is, an item indented one level }
var
   ItemText : string;
   NewIndex : LongInt; { Index of child item }
begin
  ItemText := ItemTextEd.Text;
  NewIndex := 0;
  If ItemText = '' then
      MessageDlg('You must enter text for this item!', mtInformation,
      [mbOk], 0)
  else
  If Outline1.Lines.Count = 0 then
     Outline1.Add(0,ItemText)
  else
  begin
      NewIndex := Outline1.AddChild(Outline1.SelectedItem, ItemText );
     { expand selected item so you can see your new subitem }
     Outline1[Outline1.SelectedItem].FullExpand;
     { move highlight to new subitem }
     Outline1.SelectedItem := NewIndex;
  end;
     { give focus to text edit box }
  ActiveControl:= ItemTextEd;
    { select text in edit box, ready for deletion if necessary }
  ItemTextEd.SelectAll;
 end;

procedure TForm1.DelBtnClick(Sender: TObject);
{ Deletes the current item and all child items beneath it.
  You may want to add a Yes/No message box to let the user
  confirm this deletion }
begin
      { if no item is selected, don't do anything }
   If Outline1.SelectedItem > 0 then
      Outline1.Delete(Outline1.SelectedItem);
     { give focus to text edit box }
  ActiveControl:= ItemTextEd;
  ItemTextEd.Text := '';
end;

procedure TForm1.Outline1Click(Sender: TObject);
{ Put text of selected item into edit box (handy if you want to change text) }
{ DELPHI 1 USERS NOTE: Because of a bug in the Delphi 1 Outline component,   }
{ a click event is generated when items are moved. However, the outline is   }
{ only reindexed after this event. This means, this method will cause an     }
{ 'index out of bounds' exception. Delphi 1 users may, therefore, want to    }
{ bracket out all the code between 'begin' and 'end'. This will not alter    }
{ the outliner's functionality to any significant degree.                    }
begin
If Outline1.SelectedItem > 0 then
     ItemTextEd.Text := Outline1.Items[Outline1.SelectedItem].Text;
  ActiveControl:= ItemTextEd;
end;

procedure TForm1.ExitMenuItemClick(Sender: TObject);
begin
  Close;
end;

procedure TForm1.NewMenuItemClick(Sender: TObject);
begin
  Outline1.Clear;
  OpenDialog1.FileName := '*.otl';
end;

{ Some basic File Saving and Opening procedures }
procedure TForm1.SaveAsMenuItemClick(Sender: TObject);
var
   SaveFile : boolean;
begin
   SaveFile := true;
   with SaveDialog1 do
    if Execute then
    begin
      if FileExists(FileName) then
         SaveFile := ConfirmFileSave(FileName);
      If SaveFile then
      begin
         Outline1.Lines.SaveToFile(Filename);
         OpenDialog1.Filename := Filename;
      end;
    end;
end;


procedure TForm1.SaveMenuItemClick(Sender: TObject);
begin
  if ((OpenDialog1.Filename = '') or (OpenDialog1.Filename = '*.otl')) then
    SaveAsMenuItemClick(Sender)
  else
    Outline1.Lines.SaveToFile(OpenDialog1.Filename);
end;


procedure TForm1.OpenMenuItemClick(Sender: TObject);
begin
  with OpenDialog1 do
    if Execute then
    begin
      if FileExists(FileName) Then
      begin
          Outline1.Lines.LoadFromFile(FileName);
           { if outline isn't empty, show outline expanded }
           If Outline1.SelectedItem > 0 then
              Outline1[Outline1.SelectedItem].FullExpand;
      end
      else
        MessageDlg('Sorry. Can''t load this file. '+ FileName +
                           ' does not exist!',
                        mtInformation, [mbOK], 0);
    end;
end;

procedure TForm1.ChangeBtnClick(Sender: TObject);
{ Change the text of the item selected in the outline }
begin
  If Outline1.SelectedItem > 0 then
    Outline1.Items[Outline1.SelectedItem].Text := ItemTextEd.Text;
end;

procedure TForm1.OutBtnClick(Sender: TObject);
{ Move an item out one level. This is used in place of the ChangeByLevel
  method which, in Delphi 1, does not work as documented in the Delphi help
  files and manuals }
begin
If Outline1.SelectedItem > 0 then
  with OutLine1.Items[OutLine1.SelectedItem] do begin
    { Don't do anything if this is the top item }
    if Level > 1 then
      { Move it to become a 'child' of its parent item's parent - i.e.
        move it 'out' one level }
      MoveTo(Parent.Index,oaAdd);
      Outline1[Outline1.SelectedItem].FullExpand;
  end;
end;

procedure TForm1.InBtnClick(Sender: TObject);
{ Move an item in one level. ChangeLevelBy works OK here. }
begin
  If Outline1.SelectedItem > 0 then
  begin
    with Outline1[Outline1.SelectedItem] do
       { check the item has somewhere to move to! }
      if Parent.GetPrevChild(Index) <> -1 then
        ChangeLevelBy(1);
    Outline1[Outline1.SelectedItem].FullExpand;
  end;
end;


{ DRAG AND DROP }
procedure TForm1.Outline1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  { don't do anything unless there is an item selected }
  If Outline1.SelectedItem > 0 then
    begin
       { it will accept item if dropped  }
      Accept := True;
       { higlight the item under pointer }
      Outline1.SelectedItem := Outline1.GetItem(X,Y);
    end;
end;

procedure TForm1.Outline1DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
         { move Source item (index specified by DragSourceItem) to become
           a child of the currently selected item }
 if (Source is TOutline) and ((DragSourceItem > 0)) then
    begin
        Outline1.Items[DragSourceItem].MoveTo(Outline1.SelectedItem,oaAddChild);
        { expand branch so we can see item that's been moved }
        Outline1[Outline1.SelectedItem].FullExpand;
    end;
end;



procedure TForm1.Outline1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
{ This saves the originally selected item index in the variable, DragSourceItem.
  This is necessary since the DragOver procedure continually updates the
  SelectedItem in order to place a highlight over each item beneath the mouse
  pointer. Without this variable as a place-marker, we would lose the index
  of the originally selected item. }
begin
  DragSourceItem := Outline1.GetItem(X,Y);
end;

procedure TForm1.Outline1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   If Outline1.SelectedItem > 0 then
   begin
        { only do anything if the left mouse button is pressed }
    if (ssLeft in Shift) then
        {The false parameter in BeginDrag() lets the mouse move
         5 pixels before the mouse drag-drop pointer appears. }
        Outline1.BeginDrag(false);
   end
   else Outline1.EndDrag(false);
end;

end.